perm filename DRAW.F4[MSS,LCS] blob
sn#147665 filedate 1975-02-25 generic text, type T, neo UTF8
00100 C TYPE 'DO DOD.DO'.
00110 C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
00200 C PC=PLOT PX=XGP(→PLOT.BIN) PXS,PCS=PLOT SMOOTHED CONTURE
00300 C PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
00400 C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
00500 C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
00600 C SINGLE ITEM IS RESTRICTED TO 400 WDS. 10 ITEMS PER FILE.
00610 C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
00700 COMMON /RC/MCLEF(400),IST(4000)
00800 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00900 COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
01100 COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
01300 DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
01400 COMMON/NFF/NF(1539) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
01460 EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
01510 1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
01600 1 ,(NMLST,IST(1510)),(JST,IST(500))
01700 DATA RJB/-20./,CENTR/-26./
01710 RSZ=0
01800 1 MCLEF(1)=0
02000 MM=0
02100 IPLT=0
02200 IPLTX=-1
02300 K=1
02500 91 TYPE 100
02600 55 FORMAT(I,2F)
02700 50 FORMAT(3A1)
02900 XSZ=RSZ
03000 ACCEPT 55,J,RSZ,GRID
03200 IF(RSZ.EQ.0)RSZ=XSZ
03300 MORE=-1
03400 REREAD 50,N,JC,JS
03410 IF(N.EQ.' ')GO TO 91
03500 C PXS,PCS=SMOOTH ONLY; PXZ,PCZ=SMOOTH AND FILL
03600 C TO SAVE SIZE FACTOR WHEN REDRAWING.
03610 IF(N.EQ.'Z')GO TO 1
03700 IF(RSZ.EQ.0)RSZ=9.0
03710 IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
03800 IF(N.EQ.'M'.OR.N.EQ.'R')GO TO 192
03850 IF(N.EQ.'V')CALL CNVT
03875 C V=CONVERT FROM OLD FORMAT TO NEW.
03900 C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
03910 IF(N.EQ.'F')GO TO 79
03930 C FILLS IT.
03950 IF(JS.EQ.'L')N='Z'
03975 C DEL=DELETE FROM COMB. FILE. (JS='L')
04000 IF(N.EQ.'C'.OR.N.EQ.'A'.OR.N.EQ.'Z')GO TO 999
04100 CC IF(N.EQ.'X')CALL EXIT
04200 C TYPE X TO FINISH PLOT, OTHERWISE NEW UNIT MAY BE READ IN.
04300 IF(N.EQ.'Q')GO TO 56
04350 C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
04400 IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
04500
04600 KED=N
04700 MM=MCLEF(1)
04800 IF(MM.NE.0)GO TO 92
04900 C ADD TO DRAWING?
05000 GO TO 3
05010
05020 56 CALL POG2
05030 CALL RDRAW(2,MCLEF(1),MCLEF)
05035 CALL DPYOUT(2)
05040 CALL POG1
05050 GO TO 91
05100 999 CALL CMBN
05200 GO TO 111
05250 192 IF(N.EQ.'R')MCLEF(1)=-MCLEF(1)
05300 CALL SHIFT(MCLEF(2),MCLEF(1))
05400 J=1
05500 JC=0
05600 GO TO 333
05700 191 TYPE 41
05900 IF(JC.EQ.'M'.OR.N.EQ.'S')GO TO 194
06000 MCLEF(1)=0
06100 MM=0
06200 IPLTX=-1
06300 K=1
06400 194 IF(JC.EQ.'M')MORE=0
06500 JQ=JC
06600 JC=0
06700 JM=1
06900 IF(MCLEF(1).EQ.0)GO TO 193
07140 JM=MCLEF(1)+1
07200 193 ACCEPT 10,NM,PASS
07210 IF(NM.EQ.' ')NM=LASTNM
07300 IF(NM.EQ.' '.OR.NM.EQ.'99')GO TO 91
07305 C '99' WILL BACKUP
07310 IF(N.NE.'S')LASTNM=NM
07500 IF(N.EQ.'S')GO TO 40
07600 IF(LOOKF(NM).EQ.0)GO TO 191
07700 C 'FAIL' ROUTINE TO CHECK ON LOOKUP
07950 CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
07970 C -1=READ
08000 C CAN'T USE 'GM' WITH 'COMBINED' FILE.
08010 J=1
08020 IF(KCLEF(2).EQ.0)GO TO 290
08100 TYPE 1100
08200 ACCEPT 55,J
08300 J=J+1
08350 C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
08375 IF(J.GT.10)GO TO 191
08420 290 IC=KCLEF(J)+JST(KCLEF(J))-1
08500 TYPE 110,IC
09910 60 JZ=1
09917 IF(MORE.EQ.0)JZ=JM
09920 L=KCLEF(J)-1
09930 DO 61 K=JZ,JST(L+1)+JZ-1
09935 L=L+1
09937 M=K
09940 61 MCLEF(K)=JST(L)
09960 MCLEF(1)=M
10000 1100 FORMAT(' ITEM NUM?'/)
10100 700 FORMAT(' RESET X-Y POS. ',$)
10200 555 FORMAT(2F)
10300 7 IF(MORE)GO TO 70
10400 DO 771 K=2,JM
10500 771 IF(MCLEF(K).GE.200000000)GO TO 772
10600 GO TO 70
11710 772 M=MCLEF(1)
11720 DO 773 L=K,JM
11730 M=M+1
11740 773 MCLEF(M)=MCLEF(L)
11750 K=MJ+K
11760 DO 774 L=JM,M
11770 774 MCLEF(L-K)=MCLEF(L)
11800 GO TO 3
12600
12700 70 IF(N.NE.'P')GO TO 3
12800 IXRX=-1
12900 IF(JQ.NE.'X')IXRX=0
13000 C 0=SEND IT TO CALCOMP
13100 TYPE 700
13200 ACCEPT 555,X,Y
13300 IF(X.NE.0)RJB=X/RSZ
13400 IF(Y.NE.0)CENTR=Y/RSZ
13500 C TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
13600 IF(IPLTX)CALL PLOTS(0)
13700 C DO I NEED THIS?
13710 IF(GRID.GT.0)CALL GRIDS
13800 IPLTX=0
13900 IPLT=-1
14000 3 IF(N.NE.'D')MM=0
14100 C RESET IF NOT GOING TO DRAWIT
14400 333 IF(N.EQ.'P')GO TO 337
14500 CALL DPYSET(1,IST,4000)
14600 CALL DPYBRT(4)
14700 NIST=IST(2)
14800 IF(N.AND.N.NE.'G'.AND.N.NE.'M'.AND.N.NE.'R')GO TO 92
15000 337 IF(JS.EQ.'Z')GO TO 306
15100 IF(JS.NE.'S')GO TO 338
15200 CALL SMOOTH(JS)
15300 GO TO 436
15400 338 IC=-1
15500 MM=1
15600 DO 335 K=2,MCLEF(1)
15700 IF(MCLEF(K).LT.200000000)GO TO 335
16200 IC=K
16300 GO TO 334
16400 C FOR 1ST LOC. OF MCLEF IN FILLER
16500 335 CONTINUE
16600 334 CALL RDRAW(2,MCLEF(1),MCLEF)
16700 CALL DPYOUT(1)
16800 NIST=IST(2)
16950 GO TO 436
17000 C NO FILLER
17010 79 IF(IC)GO TO 91
17020 C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
17100 TYPE 336
17200 ACCEPT 10,J
17300 JZ=N
17500 KK=0
17600 IF(J.NE.'Y')GO TO 206
17700 306 CALL SMOOTH(0)
17750 C SMOOTHS AND FILLS
17800 GO TO 436
17900 206 RR=RSZ
18100 DO 205 J=IC,MCLEF(1)
18200 CALL UNPACK(J,M,N,MCLEF)
18300 KK=KK+1
18350 KX=KK*3
18400 NF(KX)=2
18500 IF(LL.GE.100000000)NF(KX)=3
18600 QF(KK)=(M+RJB)*RR
18700 205 RF(KK)=(N+CENTR)*RR
18800 NF(3)=KX
18900 CALL FILLQ(QF,RF,NF)
19000 436 IF(JZ.EQ.'P')CALL PLOT(0,0,3)
19100 GO TO 91
19105
19110 66 TYPE 666,NM
19120 GO TO 91
19130 666 FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
19200 336 FORMAT(' SMOOTH? ',$)
19300 10 FORMAT(A5,F)
19400 5 FORMAT(12I)
19500 100 FORMAT(' G=GET, GM=GET MORE, =S=SAVE, D=DRAW, X=EXIT, M=MOVE,'/'
19600 1 P=PLOT, PX=XGP, C=COMBINE, A=ADD TO COMB. FILE
19650 1, DEL=DEL. FROM COMB.'/
19700 1' F=FILL, E=EDIT, N1=SIZE, N2=1=GRID '/)
19800 C N1=20 TO CHANGE SHAPE
19900
20000 92 IST(2)=NIST
20100 CALL DRAWIT
20200 N=0
20300 GO TO 3
20400
20500 403 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
20600 41 FORMAT(' TYPE FILE NAME'/)
20700 C SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
20800 40 IF(LOOKF(NM).EQ.0)GO TO 402
20900 TYPE 403,NM
21000 ACCEPT 50,K
21100 IF(K.EQ.'N')GO TO 191
21210 402 NMLST(1)=NM
21220 JCLEF(1)=1
21230 DO 1111 K=2,10
21240 JCLEF(K)=0
21250 1111 NMLST(K)=' '
21260 CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
21280 NQ=MCLEF(1)
21600 111 TYPE 110,NQ
21620 GO TO 91
21800 110 FORMAT(' TOTAL WDS=',I3)
21900 END